home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 14 / hacker14.iso / programacao / visual / perl.exe / {app} / Webroot / cgi-bin / graffiti2.pl < prev    next >
Encoding:
Perl Script  |  2003-01-11  |  3.1 KB  |  105 lines
  1. #!perl
  2.  
  3. # Keep a growing list of phrases from the user.
  4.  
  5. # CONSTANTS
  6. $STATE_DIR = ".";  # must be writable by 'nobody'
  7.  
  8. use CGI qw/:html/;
  9. $q = new CGI;
  10. $session_key = $q->path_info();
  11. $session_key =~ s|^/||;             # get rid of the initial slash
  12.  
  13. # If no valid session key has been provided, then we
  14. # generate one, tack it on to the end of our URL as
  15. # additional path information, and redirect the user
  16. # to this new location.
  17. unless (valid($session_key)) {
  18.     $session_key = generate_session_key();
  19.     print $q->redirect($q->url() . "/$session_key");
  20.     exit 0;
  21. }
  22.  
  23. $old = fetch_old_state($session_key);
  24.  
  25. # Add the new item(s) to the old list of items
  26. if ($q->param('action') eq 'ADD') {
  27.     $q->param(-name=>'item',
  28.               -value=>[$old->param('item'),$q->param('item')]);
  29. } elsif ($action eq 'CLEAR') {
  30.     $q->Delete('item');
  31. }
  32.  
  33. # Save the new list to disk
  34. save_state($session_key,$q);
  35.  
  36. # Now, at last, generate something for the use to look at.
  37. print $q->header,
  38.     $q->start_html("The growing list"),<<END;
  39. <h1>The Growing List</h1>
  40. Type a short phrase into the text field below.  Press <i>ADD</i>,
  41. to append it to the history of the phrases that you've typed.  The
  42. list is maintained on disk at the server end, so it won't get out of
  43. order if you press the "back" button.  Press <i>CLEAR</i> to clear the
  44. list and start fresh.  Bookmark this page to come back to the list later.
  45. END
  46.     ;
  47. print $q->start_form,
  48.     $q->textfield(-name=>'item',-default=>'',
  49.                   -size=>50,-override=>1),p(),
  50.     $q->submit(-name=>'action',-value=>'CLEAR'),
  51.     $q->submit(-name=>'action',-value=>'ADD'),
  52.     $q->end_form,
  53.     $q->hr,
  54.     $q->h2('Current list');
  55.  
  56. if ($q->param('item')) {
  57.     my @items = $q->param('item');
  58.     print ol(li(\@items));
  59. } else {
  60.     print em('Empty');
  61. }
  62. print <<END;
  63. <hr>
  64. <a href="../../source.html">Code examples</a></address>
  65. END
  66.     ;
  67. print $q->end_html;
  68.  
  69. # Silly technique: we generate a session key from a random number
  70. # generator, and keep calling until we find a unique one.
  71. sub generate_session_key {
  72.     my $key;
  73.     do {
  74.         $key = int(rand(1000000));
  75.     } until (! -e "$STATE_DIR/$key");
  76.     return $key;
  77. }
  78.  
  79. # make sure the session ID passed to us is a valid one by
  80. # looking for a numeric-only string
  81. sub valid {
  82.     my $key = shift;
  83.     return $key=~/^\d+$/;
  84. }
  85.  
  86. # Open the existing file, if any, and read the current state from it.
  87. # We use the CGI object here, because it's straightforward to do.
  88. # We don't check for success of the open() call, because if there is
  89. # no file yet, the new CGI(FILEHANDLE) call will return an empty
  90. # parameter list, which is exactly what we want.
  91. sub fetch_old_state {
  92.     my $session_key = shift;
  93.     open(SAVEDSTATE,"$STATE_DIR/$session_key") || return;
  94.     my $cgi = new CGI(SAVEDSTATE);
  95.     close SAVEDSTATE;
  96.     return $cgi;
  97. }
  98.  
  99. sub save_state {
  100.     my($session_key,$q) = @_;
  101.     open(SAVEDSTATE,">$STATE_DIR/$session_key") ||
  102.         die "Failed opening session state file: $!";
  103.     $q->save(SAVEDSTATE);
  104.     close SAVEDSTATE;
  105. }